home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1994 #2
/
Monster Media No. 2 (Monster Media)(1994).ISO
/
prog_pas
/
lzw4p14.zip
/
EX_ARC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-05-30
|
4KB
|
134 lines
(*
** EX_ARC.PAS Copyright (C) 1994 by MarshallSoft Computing, Inc.
**
** This program is used to extract a file from an archive created with MK_ARC.
** For example, to extract TEST.PAS from the archive PAS.ARF, type:
**
** EX_ARC TEST.PAS PAS.ARF
*)
program EX_ARC;
uses dos, crt, memory, rw_io, hex_io, lzw_errs, LZW4P;
type
String12 = String[12];
AllocMemoryType = function(Size : Word) : Pointer;
FreeMemoryType = function(P : Pointer; Size : Word) : Integer;
Var
InpFileName : String12;
OutFileName : String12;
Requested : String12;
MemoryP : Pointer;
AllocMemoryP : Pointer;
FreeMemoryP : Pointer;
ReaderP : Pointer;
WriterP : Pointer;
DummyP : Pointer;
Size : Integer;
Code : Integer;
i, x : Integer;
DirInfo : SearchRec;
Ratio : Real;
ReaderCnt : Real;
WriterCnt : Real;
begin (* main *)
(* get file specs *)
if ParamCount <> 2 then
begin
writeln('Usage: EX_ARC <extract_file> <arc_file>');
halt;
end;
(* sign on *)
writeln('EX_ARC 1.0: Type any key to abort...');
writeln;
(* open input *)
InpFileName := ParamStr(2);
Code := ReaderOpen(InpFileName);
if Code <> 0 then
begin
writeln('Cannot open ',InpFileName,' for input. IOResult = ',Code);
halt;
end;
(* get requested file to extract *)
Requested := ParamStr(1);
for I := 1 to 12 do
begin
Requested[I] := UpCase(Requested[I]);
end;
(* get pointers *)
AllocMemoryP := @AllocMemory;
FreeMemoryP := @FreeMemory;
ReaderP := @Reader;
WriterP := @Writer;
DummyP := @DummyWrite;
(* Initialize LZW *)
Code := InitLZW(AllocMemoryP,14);
while TRUE do
begin
(* user want to quit ? *)
if KeyPressed then
begin
writeln;
writeln('Aborted by USER');
Halt;
end;
(* get filename from archive *)
OutFileName := '';
(* get 1st character, skipping any leading 0 *)
x := Reader;
if x = 0 then x := Reader;
repeat
if x = -1 then
begin
(* close input *)
Code := ReaderClose;
(* Terminate LZW *)
Code := TermLZW(FreeMemoryP);
Halt;
end;
if x <> 0 then OutFileName := OutFileName + chr(x);
(* get next character from filename *)
x := Reader;
until x = 0;
(* writeln('<',OutFileName,'>'); *)
if OutFileName = Requested then
begin
(* open outut file *)
Code := WriterOpen(OutFileName);
if Code <> 0 then
begin
writeln('Cannot open ',OutFileName,' for output. IOResult = ',Code);
halt;
end;
(* expand *)
Write('EXPANDING ',OutFileName:12,' ');
Code := Expand(ReaderP,WriterP);
if Code < 0 then
begin
SayError(Code);
Halt;
end;
writeln('OK');
(* close output file *)
Code := WriterClose;
Code := ReaderClose;
Code := TermLZW(FreeMemoryP);
Halt;
end
else
begin
Write('Skipping ',OutFileName:12);
Code := Expand(ReaderP,DummyP);
if Code < 0 then
begin
WriteLn('Error');
SayError(Code);
Halt;
end;
WriteLn;
end;
end; (* while *)
end.